home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / peps / pepsdata.e < prev    next >
Text File  |  1994-05-02  |  25KB  |  612 lines
  1. PROC p_OpenLibraries() HANDLE /*"p_OpenLibraries()"*/
  2. /*===============================================================================
  3.  = Para         : NONE.
  4.  = Return       : ER_NONE if ok,else the error.
  5.  = Description  : Open libraries.
  6.  ==============================================================================*/
  7.     IF (intuitionbase:=OpenLibrary('intuition.library',37))=NIL THEN Raise(ER_INTUITIONLIB)
  8.     IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN Raise(ER_GADTOOLSLIB)
  9.     IF (gfxbase:=OpenLibrary('graphics.library',37))=NIL THEN Raise(ER_GRAPHICSLIB)
  10.     IF (rexxsysbase:=OpenLibrary('rexxsyslib.library',36))=NIL THEN Raise(ER_REXXSYSLIBLIB)
  11.     IF (reqtoolsbase:=OpenLibrary('reqtools.library',38))=NIL THEN Raise(ER_REQTOOLSLIB)
  12.     Raise(ER_NONE)
  13. EXCEPT
  14.     RETURN exception
  15. ENDPROC
  16. PROC p_CloseLibraries()  /*"p_CloseLibraries()"*/
  17. /*===============================================================================
  18.  = Para         : NONE
  19.  = Return       : NONE
  20.  = Description  : CLose libraries.
  21.  ==============================================================================*/
  22.     IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  23.     IF rexxsysbase THEN CloseLibrary(rexxsysbase)
  24.     IF gfxbase THEN CloseLibrary(gfxbase)
  25.     IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  26.     IF intuitionbase THEN CloseLibrary(intuitionbase)
  27. ENDPROC
  28. PROC p_SetUpScreen() HANDLE /*"p_SetUpScreen()"*/
  29. /*===============================================================================
  30.  = Para         : NONE.
  31.  = Return       : ER_NONE if ok,else the error.
  32.  = Description  : Lock wb or open the screen.
  33.  ==============================================================================*/
  34.     IF StrCmp(pubscreenname,'Workbench',9)
  35.         NOP
  36.     ELSE
  37.         IF (screen:=OpenScreenTagList(NIL,
  38.                                       [SA_TOP,0,
  39.                                        SA_DEPTH,2,
  40.                                        SA_FONT,tattr,
  41.                                        SA_DISPLAYID,typescreen,
  42.                                        SA_PUBNAME,pubscreenname,
  43.                                        SA_TITLE,'Peps v0.1 © 1994 NasGûl',
  44.                                        SA_PUBSIG,IF (screensig:=AllocSignal(-1))=NIL THEN Raise(ER_SCREENSIG) ELSE screensig,
  45.                                        SA_AUTOSCROLL,TRUE,
  46.                                        SA_TYPE,CUSTOMSCREEN+PUBLICSCREEN,
  47.                                        SA_OVERSCAN,OSCAN_TEXT,
  48.                                        SA_PENS,[0,1,1,2,1,3,1,0,2,1,2,1]:INT,
  49.                                        SA_DETAILPEN,2,
  50.                                        SA_BLOCKPEN,1,
  51.                                        0,0]))=NIL THEN Raise(ER_OPENSCREEN)
  52.         PubScreenStatus(screen,0)
  53.         IF screenbydefault THEN SetDefaultPubScreen(pubscreenname)
  54.         IF screenshanghai THEN SetPubScreenModes(SHANGHAI)
  55.     ENDIF
  56.     IF (screen:=LockPubScreen(pubscreenname))=NIL
  57.         IF (screen:=LockPubScreen('Workbench'))=NIL THEN Raise(ER_LOCKSCREEN)
  58.     ENDIF
  59.     IF (visual:=GetVisualInfoA(screen,NIL))=NIL THEN Raise(ER_VISUAL)
  60.     offy:=screen.wbortop+Int(screen.rastport+58)+1
  61.     Raise(ER_NONE)
  62. EXCEPT
  63.     RETURN exception
  64. ENDPROC
  65. PROC p_SetDownScreen() /*"p_SetDownScreen()"*/
  66. /*===============================================================================
  67.  = Para         : NONE
  68.  = Return       : NONE
  69.  = Description  : Unlock screnn,clse screen if screen open,wait all windows
  70.  =                in screen to be closed.
  71.  ==============================================================================*/
  72.     dWriteF(['p_SetDownScreen()\n'],0)
  73.     IF StrCmp(pubscreenname,'Workbench',9)
  74.         IF visual THEN FreeVisualInfo(visual)
  75.         IF screen THEN UnlockPubScreen(NIL,screen)
  76.     ELSE
  77.         IF visual THEN FreeVisualInfo(visual)
  78.         IF screen THEN UnlockPubScreen(NIL,screen)
  79.         IF screen.firstwindow<>0
  80.             Wait(Shl(1,screensig))
  81.         ENDIF
  82.         IF screensig<>-1 THEN FreeSignal(screensig)
  83.         IF screen THEN CloseScreen(screen)
  84.         IF screenbydefault THEN SetDefaultPubScreen(NIL)
  85.     ENDIF
  86.     dWriteF(['p_SetDownScreen() Ok\n'],0)
  87. ENDPROC
  88. PROC p_InitppWindow() HANDLE /*"p_InitppWindow()"*/
  89. /*===============================================================================
  90.  = Para         : NONE
  91.  = Return       : ER_NONE if ok,else the error.
  92.  = Description  : build gadgets list.
  93.  ==============================================================================*/
  94.     dWriteF(['p_InitppWindow()\n'],0)
  95.     IF nomenu=FALSE
  96.         IF (menu:=CreateMenusA(save_list_chip,NIL))=NIL THEN Raise(ER_MENUS)
  97.         IF LayoutMenusA(menu,visual,NIL)=FALSE THEN Raise(ER_MENUS)
  98.     ENDIF
  99.     IF (pp_glist:=CreateContext({pp_glist}))=NIL THEN Raise(ER_CONTEXT)
  100.     IF (g_source:=CreateGadgetA(TEXT_KIND,pp_glist,[80,17,321,12,'ESource',tattr,0,1,visual,0]:newgadget,[GTTX_BORDER,TRUE,GTTX_TEXT,esource,GTTX_COPYTEXT,FALSE,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  101.     IF (g_filelist:=CreateGadgetA(LISTVIEW_KIND,g_source,[38,40,254,33,'File(s).',tattr,1,2,visual,0]:newgadget,[GTLV_SHOWSELECTED,NIL,GTLV_LABELS,-1,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  102.     IF (g_proclist:=CreateGadgetA(LISTVIEW_KIND,g_filelist,[37,78,254,41,'Proc(s).',tattr,2,2,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GTLV_READONLY,TRUE,GTLV_LABELS,-1,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  103.     IF (g_errorslist:=CreateGadgetA(LISTVIEW_KIND,g_proclist,[39,121,253,81,'Error(s).',tattr,3,2,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GTLV_READONLY,TRUE,GTLV_LABELS,-1,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  104.     Raise(ER_NONE)
  105. EXCEPT
  106.     dWriteF(['p_InitppWindow()  Retour:\d\n'],[exception])
  107.     RETURN exception
  108. ENDPROC
  109. PROC p_RenderppWindow() /*"p_RenderppWindow()"*/
  110. /*===============================================================================
  111.  = Para         : NONE
  112.  = Return       : NONE
  113.  = Description  : redraw bevelbox,clean listview if list is empty.
  114.  ==============================================================================*/
  115.     dWriteF(['p_RenderppWindow()\n'],0)
  116.     IF (p_EmptyList(myb.pmodulelist))<>-1
  117.         Gt_SetGadgetAttrsA(g_filelist,pp_window,NIL,[GTLV_LABELS,myb.pmodulelist,TAG_DONE,0])
  118.     ELSE
  119.         Gt_SetGadgetAttrsA(g_filelist,pp_window,NIL,[GTLV_LABELS,emptylist,TAG_DONE,0])
  120.     ENDIF
  121.     DrawBevelBoxA(pp_window.rport,9,13,401,20,[GT_VISUALINFO,visual,TAG_DONE,0])
  122.     DrawBevelBoxA(pp_window.rport,9,35,401,167,[GT_VISUALINFO,visual,TAG_DONE,0])
  123.     RefreshGList(g_source,pp_window,NIL,-1)
  124.     Gt_RefreshWindow(pp_window,NIL)
  125.     dWriteF(['p_RenderppWindow() Ok.\n'],0)
  126. ENDPROC
  127. PROC p_OpenppWindow() HANDLE /*"p_OpenppWindow()"*/
  128. /*===============================================================================
  129.  = Para         : NONE
  130.  = Return       : ER_NONE if ok,else the error.
  131.  = Description  : Open window.
  132.  ==============================================================================*/
  133.     dWriteF(['p_OpenppWindow()\n'],0)
  134.     IF (pp_window:=OpenWindowTagList(NIL,
  135.                       [WA_LEFT,347,
  136.                        WA_TOP,0,
  137.                        WA_WIDTH,419,
  138.                        WA_HEIGHT,206,
  139.                        WA_IDCMP,$400278+IDCMP_REFRESHWINDOW+IDCMP_MENUPICK,
  140.                        WA_FLAGS,$102E+WFLG_HASZOOM,
  141.                        WA_GADGETS,pp_glist,
  142.                        WA_TITLE,'Peps v0.1 © 1994 NasGûl',
  143.                        WA_ZOOM,[347,0,419,11]:INT,
  144.                        WA_PUBSCREENNAME,pubscreenname,
  145.                        WA_PUBSCREEN,screen,
  146.                        WA_CUSTOMSCREEN,screen,
  147.                        WA_BLOCKPEN,2,
  148.                        WA_DETAILPEN,1,
  149.                        WA_SCREENTITLE,'Made With GadToolsBox v2.0 © 1991-1993',
  150.                        TAG_DONE]))=NIL THEN Raise(ER_WINDOW)
  151.     IF nomenu=FALSE
  152.         IF SetMenuStrip(pp_window,menu)=FALSE THEN Raise(ER_MENUS)
  153.     ENDIF
  154.     p_RenderppWindow()
  155.     Raise(ER_NONE)
  156. EXCEPT
  157.     dWriteF(['p_OpenppWindow() Retour:\d\n'],[exception])
  158.     RETURN exception
  159. ENDPROC
  160. PROC p_RemppWindow() /*"p_RemppWindow()"*/
  161. /*===============================================================================
  162.  = Para         : NONE
  163.  = Return       : NONE
  164.  = Description  : Free gadgetlist and close window.
  165.  ==============================================================================*/
  166.     IF nomenu=FALSE
  167.         IF pp_window THEN ClearMenuStrip(pp_window)
  168.     ENDIF
  169.     IF pp_window THEN CloseWindow(pp_window)
  170.     IF pp_glist THEN FreeGadgets(pp_glist)
  171.     IF nomenu=FALSE
  172.         IF menu THEN FreeMenus(menu)
  173.     ENDIF
  174. ENDPROC
  175. PROC p_StartCli() HANDLE /*"p_StartCli()"*/
  176. /*===============================================================================
  177.  = Para         : NONE
  178.  = Return       : ER_NONE if ok,else the error.
  179.  = Description  : Parsing Cli Arguments.
  180.  ==============================================================================*/
  181.     DEF myargs:PTR TO LONG,rdargs=NIL,h,pos
  182.     DEF edname[80]:STRING,edopt[80]:STRING
  183.     DEF temp,clock
  184.     myargs:=[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
  185.     temp:='ESource,'+
  186.           'EC/K,'+
  187.           'PS=PubScreenName/K,'+
  188.           'TF=TempFile/K,'+
  189.           'AP=ArexxPortName/K,'+
  190.           'EN=ExecName/K,'+
  191.           'ED=EditorName/K,'+
  192.           'EP=EditorPortName/K,'+
  193.           'ER=ErrorArexxScriptName/K,'+
  194.           'MF=MenuFile/K,'+
  195.           'DT=DelTemp/S,'+
  196.           'JE=JustEC/S,'+
  197.           'IC=InsComment/S,'+
  198.           'Hires/S,'+
  199.           'DF=PubScreenByDef/S,'+
  200.           'SG=PubScreenShanghai/S'
  201.     IF ReadArgs(temp,myargs,NIL)
  202.     IF myargs[0] /* ESOURCE */
  203.         StrCopy(esource,myargs[0],ALL)
  204.         IF FileLength(esource)=-1 THEN Raise(ER_NOFILE)
  205.         IF (pos:=InStr(esource,':',0))<>-1 THEN Raise(ER_SAMEDIR)
  206.         IF (pos:=InStr(esource,'/',0))<>-1 THEN Raise(ER_SAMEDIR)
  207.     ELSE
  208.         Raise(ER_NOFILE)
  209.     ENDIF
  210.     IF myargs[1] /* ECOPT */
  211.         StrCopy(ec,myargs[1],ALL)
  212.     ELSE
  213.         StrCopy(ec,'-e',ALL)
  214.     ENDIF
  215.     IF myargs[2] /* PUBSCREENNAME */
  216.         StrCopy(pubscreenname,myargs[2],ALL)
  217.     ELSE
  218.         StrCopy(pubscreenname,'Workbench',ALL)
  219.     ENDIF
  220.     IF myargs[3] /* TEMPFILE */
  221.         StrCopy(tempfile,myargs[3],ALL)
  222.         pos:=InStr(tempfile,'.e',0)
  223.         IF pos=-1 THEN StrAdd(tempfile,'.e',ALL)
  224.         IF h:=Open(tempfile,1006)
  225.         Close(h)
  226.         ELSE
  227.         Raise(ER_TEMPNOVALID)
  228.         ENDIF
  229.     ELSE
  230.         StrCopy(tempfile,'T:PepsMain.e',ALL)
  231.     ENDIF
  232.     pos:=InStr(tempfile,'.e',ALL)
  233.     MidStr(ecsource,tempfile,0,pos)
  234.     IF myargs[4] /* AREXXPORTNAME */
  235.         StrCopy(prgportname,myargs[4],ALL)
  236.     ELSE
  237.         StrCopy(prgportname,'PepsPort',ALL)
  238.     ENDIF
  239.     IF myargs[5] /* EXECNAME */
  240.         StrCopy(execname,myargs[5],ALL)
  241.     ELSE
  242.         pos:=InStr(esource,'.e',0)
  243.         MidStr(execname,esource,0,pos)
  244.     ENDIF
  245.     IF h:=Open(execname,1006)
  246.         Close(h)
  247.         DeleteFile(execname)
  248.     ELSE
  249.         Raise(ER_EXENOVALID)
  250.     ENDIF
  251.     IF myargs[6] /* EDITORNAME */
  252.         pos:=InStr(myargs[6],'[]',0)
  253.         IF pos<>-1
  254.         MidStr(edname,myargs[6],0,pos)
  255.         MidStr(edopt,myargs[6],pos+3,ALL)
  256.         StringF(editorcommand,'\s \s \s',edname,esource,edopt)
  257.         ELSE
  258.         StringF(editorcommand,'\s \s',myargs[6],esource)
  259.         ENDIF
  260.     ELSE
  261.         StringF(editorcommand,'ED \s',esource)
  262.     ENDIF
  263.     IF myargs[7] /* EDITORPORTNAME */
  264.         StrCopy(edarexxportname,myargs[7],ALL)
  265.     ELSE
  266.         StrCopy(edarexxportname,'',ALL)
  267.     ENDIF
  268.     IF myargs[8] /* ERRORAREXXSCRIPTNAME */
  269.         StrCopy(erscriptname,myargs[8],ALL)
  270.         arexxer:=TRUE
  271.     ELSE
  272.         StrCopy(erscriptname,'PepsError',ALL)
  273.         arexxer:=TRUE
  274.     ENDIF
  275.     IF myargs[9] /* MENUFILE */
  276.         IF FileLength(myargs[9])<>-1
  277.             StrCopy(menufile,myargs[9],ALL)
  278.         ELSE
  279.             StrCopy(menufile,'peps.Menus',ALL)
  280.         ENDIF
  281.     ELSE
  282.         nomenu:=TRUE
  283.     ENDIF
  284.     /* BOLL ARGS */
  285.     IF myargs[10] THEN b_deletetemp:=TRUE
  286.     IF myargs[11] THEN compilandexit:=TRUE
  287.     IF myargs[12] THEN insertcomment:=TRUE
  288.     IF myargs[13] THEN typescreen:=HIRES_KEY
  289.     IF myargs[14] THEN screenbydefault:=TRUE
  290.     IF myargs[15] THEN screenshanghai:=TRUE
  291.     ELSE
  292.     Raise(ER_BADARGS)
  293.     ENDIF
  294.     /*
  295.     WriteF('Source   :\s\n',esource)
  296.     WriteF('EC opt   :\s\n',ec)
  297.     WriteF('PubScr   :\s\n',pubscreenname)
  298.     WriteF('TempFile :\s\n',tempfile)
  299.     IF b_deletetemp THEN WriteF('DelTemp.\n') ELSE WriteF('No DelTemp.\n')
  300.     WriteF('PortName :\s\n',prgportname)
  301.     WriteF('ExecName :\s\n',execname)
  302.     */
  303.     IF clock:=Lock('',-2)
  304.     NameFromLock(clock,currentdir,256)
  305.     AddPart(currentdir,'',256)
  306.     UnLock(clock)
  307.     ENDIF
  308.     Raise(ER_NONE)
  309. EXCEPT
  310.     IF rdargs THEN FreeArgs(rdargs)
  311.     RETURN exception
  312. ENDPROC
  313. PROC p_OpenConsole() HANDLE /*"p_OpenConsole()"*/
  314. /*===============================================================================
  315.  = Para         : NONE
  316.  = Return       : ER_NONE if ok,else the error.
  317.  = Description  : Open the Output console.
  318.  ==============================================================================*/
  319.     StringF(myconout,'Con:0/0/640/80/PepsOut/Auto/Wiat/Close/Screen \s',pubscreenname)
  320.     IF (myout:=Open(myconout,1006))=NIL THEN Raise(ER_CONOUT)
  321.     Raise(ER_NONE)
  322. EXCEPT
  323.     RETURN exception
  324. ENDPROC
  325. PROC p_CloseConsole() /*"p_CloseConsole()"*/
  326. /*===============================================================================
  327.  = Para         : NONE
  328.  = Return       : NONE
  329.  = Description  : Close the output console.
  330.  ==============================================================================*/
  331.     IF myout THEN Close(myout)
  332. ENDPROC
  333. PROC p_CreateArexxPort(nom,pri) HANDLE /*"p_CreateArexxPort(nom,pri)"*/
  334. /*===============================================================================
  335.  = Para         : name (STRING),pri (NUM).
  336.  = Return       : the address of the port if ok,else NIL.
  337.  = Description  : Create a public port.
  338.  ==============================================================================*/
  339.     DEF dat_port:PTR TO ln
  340.     IF FindPort(nom)<>0 THEN Raise(ER_PORTEXIST)
  341.     arexxport:=CreateMsgPort()
  342.     IF arexxport=0
  343.     Raise(ER_CREATEPORT)
  344.     ENDIF
  345.     dat_port:=arexxport.ln
  346.     dat_port.name:=nom
  347.     dat_port.pri:=pri
  348.     dat_port.type:=NT_MSGPORT
  349.     arexxport.flags:=PA_SIGNAL
  350.     IF nom<>NIL
  351.     AddPort(arexxport)
  352.     ENDIF
  353.     Raise(ER_NONE)
  354. EXCEPT
  355.     RETURN exception
  356. ENDPROC
  357. PROC p_DeleteArexxPort(adr_port:PTR TO mp) /*"p_DeleteArexxPort(adr_port:PTR TO mp)"*/
  358. /*===============================================================================
  359.  = Para         : Address of port.
  360.  = Return       : NONE
  361.  = Description  : Remove a public port.
  362.  ==============================================================================*/
  363.     DEF data_port:PTR TO ln
  364.     data_port:=adr_port.ln
  365.     IF data_port.name<>NIL THEN RemPort(adr_port)
  366.     IF adr_port THEN DeleteMsgPort(adr_port)
  367. ENDPROC
  368. PROC p_InitPeps() HANDLE /*"p_InitPeps()"*/
  369. /*===============================================================================
  370.  = Para         : NONE
  371.  = Return       : ER_NONE if ok,else the error.
  372.  = Description  : Init the eubase structure.
  373.  ==============================================================================*/
  374.     IF (myb:=New(SIZEOF eubase))=NIL THEN Raise(ER_MEM)
  375.     myb.pmodulelist:=p_InitList()
  376.     myb.proclist:=p_InitList()
  377.     myb.infolist:=p_InitList()
  378.     emptylist:=p_InitList()
  379.     IF ((myb.pmodulelist=0) OR
  380.         (myb.proclist=0) OR (myb.infolist=0) OR (emptylist=0)) THEN Raise(ER_MEM)
  381.     p_AjouteNode(emptylist,' ',0)
  382.     Raise(ER_NONE)
  383. EXCEPT
  384.     RETURN exception
  385. ENDPROC
  386. PROC p_RemPeps() /*"p_RemPeps()"*/
  387. /*===============================================================================
  388.  = Para         : NONE
  389.  = Return       : NONE
  390.  = Description  : Remove the eubase structure.
  391.  ==============================================================================*/
  392.     IF myb.pmodulelist THEN p_CleanPmoduleList(myb.pmodulelist)
  393.     IF myb.proclist THEN p_RemoveList(myb.proclist)
  394.     IF myb.infolist THEN p_RemoveList(myb.infolist)
  395.     IF emptylist THEN p_RemoveList(emptylist)
  396. ENDPROC
  397. PROC p_RemoveList(ptr_list:PTR TO lh) /*"p_RemoveList(ptr_list:PTR TO lh)"*/
  398. /*===============================================================================
  399.  = Para         : Address of list.
  400.  = Return       : NONE.
  401.  = Description  : p_CleanList() and dispose the list.
  402.  ==============================================================================*/
  403.     DEF r_list:PTR TO lh
  404.     r_list:=p_CleanList(ptr_list)
  405.     IF r_list THEN Dispose(r_list)
  406. ENDPROC
  407. PROC p_InitList() HANDLE /*"p_InitList()"*/
  408. /*===============================================================================
  409.  = Para         : NONE
  410.  = Return       : address of the new list if ok,else NIL.
  411.  = Description  : Initialise a list.
  412.  ==============================================================================*/
  413.     DEF i_list:PTR TO lh
  414.     i_list:=New(SIZEOF lh)
  415.     i_list.tail:=0
  416.     i_list.head:=i_list.tail
  417.     i_list.tailpred:=i_list.head
  418.     i_list.type:=0
  419.     i_list.pad:=0
  420.     IF i_list THEN Raise(i_list) ELSE Raise(NIL)
  421. EXCEPT
  422.     RETURN exception
  423. ENDPROC
  424. PROC p_GetNumNode(ptr_list:PTR TO lh,adr_node) /*"p_GetNumNode(ptr_list:PTR TO lh,adr_node)"*/
  425. /*===============================================================================
  426.  = Para         : address of list,address of node
  427.  = Return       : the number of the node if ok else -1.
  428.  = Description  : Find the number of a node.
  429.  ==============================================================================*/
  430.     DEF g_node:PTR TO ln
  431.     DEF count=0
  432.     g_node:=ptr_list.head
  433.     WHILE g_node
  434.         IF g_node=adr_node THEN RETURN count
  435.         INC count
  436.         g_node:=g_node.succ
  437.     ENDWHILE
  438.     RETURN NIL
  439. ENDPROC
  440. PROC p_GetAdrNode(ptr_list:PTR TO lh,num_node) /*"p_GetAdrNode(ptr_list:PTR TO lh,num_node)"*/
  441. /*==============================================================================
  442.  = Para         : address of list,number's node.
  443.  = Return       : address of node or NIL.
  444.  = Description  : Find the address of a node.
  445.  ==============================================================================*/
  446.     DEF g_node:PTR TO ln
  447.     DEF count=0
  448.     g_node:=ptr_list.head
  449.     WHILE g_node
  450.         IF count=num_node THEN RETURN g_node
  451.         INC count
  452.         g_node:=g_node.succ
  453.     ENDWHILE
  454.     RETURN NIL
  455. ENDPROC
  456. PROC p_EmptyList(ptr_list:PTR TO lh) /*"p_EmptyList(ptr_list:PTR TO lh)"*/
  457. /*===============================================================================
  458.  = Para         : address of list.
  459.  = Return       : TRUE if list is empty,else address of list.
  460.  = Description  : Look if a list is empty.
  461.  ==============================================================================*/
  462.     DEF count=0
  463.     DEF e_node:PTR TO ln
  464.     e_node:=ptr_list.head
  465.     WHILE e_node
  466.         IF e_node.succ<>0 THEN INC count
  467.         e_node:=e_node.succ
  468.     ENDWHILE
  469.     IF count=0 THEN RETURN TRUE ELSE RETURN ptr_list
  470. ENDPROC
  471. PROC p_CleanList(ptr_list:PTR TO lh) /*"p_CleanList(ptr_list:PTR TO lh)"*/
  472. /*===============================================================================
  473.  = Para         : address of list
  474.  = Return       : address of clean list
  475.  = Description  : Remove all nodes in the list.
  476.  ==============================================================================*/
  477.     DEF c_node:PTR TO ln
  478.     c_node:=ptr_list.head
  479.     WHILE c_node
  480.         IF c_node.succ<>0
  481.             IF c_node.name THEN DisposeLink(c_node.name)
  482.         ENDIF
  483.         IF c_node.succ=0 THEN RemTail(ptr_list)
  484.         IF c_node.pred=0 THEN RemHead(ptr_list)
  485.         IF (c_node.succ<>0) AND (c_node.pred<>0) THEN Remove(c_node)
  486.         c_node:=c_node.succ
  487.     ENDWHILE
  488.     ptr_list.tail:=0
  489.     ptr_list.head:=ptr_list.tail
  490.     ptr_list.tailpred:=ptr_list.head
  491.     ptr_list.type:=0
  492.     ptr_list.pad:=0
  493.     RETURN ptr_list
  494. ENDPROC
  495. PROC p_AjouteNode(ptr_list:PTR TO lh,node_name,adr) HANDLE /*"p_AjouteNode(ptr_list:PTR TO lh,node_name,adr)"*/
  496. /*===============================================================================
  497.  = Para         : address of list,the name of a node,adr to copy node if adr<>0.
  498.  = Return       : the number of the new selected node in the list.
  499.  = Description  : Add a node and return the new current node (for LISTVIEW_KIND).
  500.  ===============================================================================*/
  501.     DEF a_node:PTR TO ln
  502.     DEF nn=NIL
  503.     a_node:=New(SIZEOF ln)
  504.     a_node.succ:=0
  505.     a_node.name:=String(EstrLen(node_name))
  506.     StrCopy(a_node.name,node_name,ALL)
  507.     IF adr<>0  /* Copy the node in the structure) */
  508.         CopyMem(a_node,adr,SIZEOF ln)
  509.         AddTail(ptr_list,adr)
  510.         nn:=p_GetNumNode(ptr_list,adr)
  511.     ELSE
  512.         AddTail(ptr_list,a_node)
  513.         nn:=p_GetNumNode(ptr_list,a_node)
  514.     ENDIF
  515.     IF nn=0
  516.         IF adr=0 THEN ptr_list.head:=a_node ELSE ptr_list.head:=adr
  517.         a_node.pred:=0
  518.     ENDIF
  519.     IF adr<>0 THEN Dispose(a_node) /* node is copied,free it */
  520.     Raise(nn)
  521. EXCEPT
  522.     RETURN exception
  523. ENDPROC
  524. PROC p_AjouteInfoNode(ptr_list:PTR TO lh,node_name) HANDLE /*"p_AjouteInfoNode(ptr_list:PTR TO lh,node_name)"*/
  525. /*===============================================================================
  526.  = Para         : address of list,the name of a node.
  527.  = Return       : the number of the new selected node in the list.
  528.  = Description  : Add a node and return the new current node (for LISTVIEW_KIND).
  529.  =                and refresh the window.
  530.  ==============================================================================*/
  531.     DEF a_node:PTR TO ln
  532.     DEF nn=NIL
  533.     Gt_SetGadgetAttrsA(g_errorslist,pp_window,NIL,[GTLV_LABELS,-1,TAG_DONE,0])
  534.     a_node:=New(SIZEOF ln)
  535.     a_node.succ:=0
  536.     a_node.name:=String(EstrLen(node_name))
  537.     StrCopy(a_node.name,node_name,ALL)
  538.     AddTail(ptr_list,a_node)
  539.     nn:=p_GetNumNode(ptr_list,a_node)
  540.     IF nn=0
  541.         ptr_list.head:=a_node
  542.         a_node.pred:=0
  543.     ENDIF
  544.     Gt_SetGadgetAttrsA(g_errorslist,pp_window,NIL,[GTLV_TOP,nn,GTLV_LABELS,p_EmptyList(myb.infolist),TAG_DONE,0])
  545.     Raise(nn)
  546. EXCEPT
  547.     RETURN exception
  548. ENDPROC
  549. PROC p_CleanPmoduleList(ptr_list:PTR TO lh) /*"p_CleanPmoduleList(ptr_list:PTR TO lh)"*/
  550. /*===============================================================================
  551.  = Para         : address of list
  552.  = Return       : NONE
  553.  = Description  : Clean the eubase.pmoduleslist (all filenode and procnode are deleted).
  554.  ===============================================================================*/
  555.     DEF w_fnode:PTR TO ln
  556.     DEF w_pnode:PTR TO ln
  557.     DEF w_filenode:PTR TO filenode
  558.     DEF w_procnode:PTR TO procnode
  559.     DEF pivlist:PTR TO lh
  560.     w_filenode:=ptr_list.head
  561.     WHILE w_filenode
  562.         w_fnode:=w_filenode
  563.         IF w_fnode.succ<>0
  564.             IF w_fnode.name THEN DisposeLink(w_fnode.name)
  565.             IF p_EmptyList(w_filenode.deflist)<>-1 THEN p_CleanList(w_filenode.deflist)
  566.             IF p_EmptyList(w_filenode.proclist)<>-1
  567.                 pivlist:=w_filenode.proclist
  568.                 w_procnode:=pivlist.head
  569.                 WHILE w_procnode
  570.                     w_pnode:=w_procnode
  571.                     IF w_pnode.succ<>0
  572.                         IF w_pnode.name THEN DisposeLink(w_pnode.name)
  573.                         IF w_procnode.buffer THEN Dispose(w_procnode.buffer)
  574.                         IF w_procnode THEN Dispose(w_procnode)
  575.                         IF w_pnode.succ=0 THEN RemTail(w_filenode.proclist)
  576.                         IF w_pnode.pred=0 THEN RemHead(w_filenode.proclist)
  577.                         IF (w_pnode.succ<>0) AND (w_pnode.pred<>0) THEN Remove(w_pnode)
  578.                     ENDIF
  579.                     w_procnode:=w_pnode.succ
  580.                 ENDWHILE
  581.             ENDIF
  582.             IF w_filenode THEN Dispose(w_filenode)
  583.             IF w_fnode.succ=0 THEN RemTail(ptr_list)
  584.             IF w_fnode.pred=0 THEN RemHead(ptr_list)
  585.             IF (w_pnode.succ<>0) AND (w_pnode.pred<>0) THEN Remove(w_pnode)
  586.         ENDIF
  587.         w_filenode:=w_fnode.succ
  588.     ENDWHILE
  589.     ptr_list.tail:=0
  590.     ptr_list.head:=ptr_list.tail
  591.     ptr_list.tailpred:=ptr_list.head
  592.     ptr_list.type:=0
  593.     ptr_list.pad:=0
  594. ENDPROC
  595. PROC p_CleanAllList() /*"p_CleanAllList()"*/
  596. /*===============================================================================
  597.  = Para         : NONE.
  598.  = Return       : NONE.
  599.  = Description  : Lock listview and clen all list.
  600.  ==============================================================================*/
  601.     Gt_SetGadgetAttrsA(g_proclist,pp_window,NIL,[GTLV_LABELS,-1,TAG_DONE,0])
  602.     Gt_SetGadgetAttrsA(g_filelist,pp_window,NIL,[GTLV_LABELS,-1,TAG_DONE,0])
  603.     Gt_SetGadgetAttrsA(g_errorslist,pp_window,NIL,[GTLV_LABELS,-1,TAG_DONE,0])
  604.     p_CleanList(myb.proclist)
  605.     p_CleanList(myb.infolist)
  606.     p_CleanPmoduleList(myb.pmodulelist)
  607.     Gt_SetGadgetAttrsA(g_proclist,pp_window,NIL,[GTLV_LABELS,emptylist,TAG_DONE,0])
  608.     Gt_SetGadgetAttrsA(g_filelist,pp_window,NIL,[GTLV_LABELS,emptylist,TAG_DONE,0])
  609.     Gt_SetGadgetAttrsA(g_errorslist,pp_window,NIL,[GTLV_LABELS,emptylist,TAG_DONE,0])
  610. ENDPROC
  611.  
  612.